/*
    REDLisp - interpreter/compiler for new dialect of LISP called REDLISP
    Copyright (C) 2006  Rudolf Olah

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*/

#include "functions.h"

void
loadCoreFunctions ()
{
  if (system_environment == 0)
    {
      console->WriteLine ("FATAL: No system environment has been set!");
      exit (1);
    }
  
  addToSystem ("system", system_environment);
  addToSystem ("loaded", loaded_modules);
  addToSystem ("T", T);
  addToSystem ("nil", nil);

  addToSystem ("os", new dString (
#ifdef TARGET_OS_WINDOWS
				  "Windows"
#endif
#ifdef TARGET_OS_LINUX
				  "Linux"
#endif
#ifdef TARGET_OS_MACOSX
				  "Mac OS X"
#endif
				  ));
  addToSystem ("version", new dString ("REDLisp 0.53"));

  addToSystem ("cons", dCons);
  addToSystem ("list", dMakeList);
  addToSystem ("first", dFirst);
  addToSystem ("last", dLast);
  addToSystem ("rest", dRest);

  addToSystem ("read-line", dInput);
  addToSystem ("format", dFormat);
  addToSystem ("print", dPrint);
  addToSystem ("quit", dQuit);

  addToSystem ("quote", dQuote);
  addToSystem ("function", dMakeLambda);
  addToSystem ("if", dIf);
  addToSystem ("eval", dEval);
  addToSystem ("split", dTokenize);

  addToSystem ("load", dLoad);

  addToSystem ("eq", dEquals);
  addToSystem (">", dMoreThan);
  addToSystem ("<", dLessThan);
  addToSystem (">=", dMoreThanEquals);
  addToSystem ("<=", dLessThanEquals);
  addToSystem ("and", dAnd);
  addToSystem ("or", dOr);
  addToSystem ("xor", dXor);
  addToSystem ("not", dNot);

  addToSystem ("sys", dSystemCall);
  

  addToSystem ("+", dAdd);
  addToSystem ("-", dSubtract);
  addToSystem ("*", dMultiply);
  addToSystem ("/", dDivide);
  addToSystem ("div", dDiv);
  addToSystem ("mod", dMod);
  addToSystem ("datetime", dDateTime);
  addToSystem ("lookup", dLookup);
  addToSystem ("atom", dIsAtom);

  addToSystem ("cut", dSlice);
  addToSystem ("len", dLength);
}

// (cons item item) => list
dObject *
dCons (dList *args)
{
  if (args == 0 || args->size != 2 || (*args)[1]->type != 'l')
    return new dError ("requires two arguments");
  dList *newlist, *temp;
  newlist = new dList ();
  temp = (dList*)(*args)[1];
  newlist->append ((*args)[0]);
  // Cheap dirty hack, iterates through the list and appends to the new cons
  for (int i = 0; i < temp->size; i++)
    newlist->append ((*temp)[i]);
  return newlist;
}

// (list etc) => list
dObject *
dMakeList (dList *args)
{
  if (args == 0)
    return new dError ("requires at least one argument");
  dList *createdList = new dList ();
  dNode *current = args->first;
  while (current != 0)
    {
      if (current->car != 0)
	createdList->append (current->car);
      current = current->cdr;
    }
  return createdList;
}

dObject *
dFirst (dList *args)
{
  if (args == 0 || args->size != 1 || (*args)[0]->type != 'l')
    return new dError ("requires a list");
  dList *temp = (dList*)(*args)[0];
  if (temp->size == 0)
    {
      console->WriteLine ("Warning: list has size of 0, returning nil");
      return nil;
    }
  return (*temp)[0];
}

dObject *
dRest (dList *args)
{
  if (args == 0 || args->size > 1 || (*args)[0]->type == 'l')
    return new dError ("requires a list");
  dList *temp = (dList*)(*args)[0];
  dNode *current = temp->first->cdr;
  dList *result = new dList ();
  while (current != 0)
    {
      result->append (current);
      current = current->cdr;
    }
  return result;
}

dObject *
dLast (dList *args)
{
  if (args == 0 || args->size > 1 || (*args)[0]->type == 'l')
    return new dError ("requires a list");
  dList *temp = (dList*)(*args)[0];
  return (*temp)[temp->size-1];
}

dObject *
dQuote (dList *args)
{
  if (args == 0 || args->size != 1)
    return new dError ("quote requires 1 argument, a symbol");
  //debug (args);
  if (args->size == 1)
    return (dSymbol*)(*args)[0];
  return (*args)[0];
}

dObject *
dTokenize (dList *args)
{
  if (args == 0 || args->size > 1 || (*args)[0]->type != 's')
    return new dError ("tokenize: requires 1 string argument");
  else
    {
      string temp = dProcessString (((dString*)(*args)[0])->value);
      dList *out = tokenize (temp, ' ');
      for (int i = 0; i < out->size; i++)
	{
	  ((dString*)(*out)[i])->value.insert (0, "\"");
	  ((dString*)(*out)[i])->value.append ("\"");
	}
      return out;
    }
}

dObject *
dLookup (dList *args)
{
  if (args == 0 || args->size != 2 || (*args)[0]->type != 'l' || (*args)[1]->type != 'S')
    return new dError ("assoc accepts a list and a symbol argument (assoc alist key)");
  string key = ((dSymbol*)(*args)[1])->name;
  dList *list = ((dList*)(*args)[0]);
  dObject *current;
  dList *pair;
  for (int i = 0; i < list->size; i++)
    {
      current = (*list)[i];
      if (current->type == 'l') // It's a list
	{
	  pair = ((dList*)current);
	  if ((*pair)[0]->type == 'S')
	    {
	      if (((dSymbol*)(*pair)[0])->name == key)
		return (*pair)[1];
	    }
	  else
	    return new dError ("assoc accepts only a list of key/value pairs, keys must be symbols");
	}
      else
	return new dError ("assoc accepts only a list of key/value pairs");
    }
  return nil;
}

dObject *
dSystemCall (dList *args)
{
  if (args == 0 || args->size > 1 || (*args)[0]->type != 's')
    return new dError ("requires a string");
  dList *in = new dList ();
  char buffer[256];
  string temp; temp.reserve (258);
  string command = dProcessString (((dString*)(*args)[0])->value);
  if (command[0] == '\"')
    command.erase (0, 1);
  if (*command.end () == '\"')
    command.erase (command.end ()-1, command.end ());
  FILE *pipeIn = _popen (command.c_str (), "r");
  while (!feof (pipeIn))
    if (fgets (buffer, 256, pipeIn) != NULL)
      {
	temp = "\"";
	temp += buffer;
	temp.erase (temp.end ()-1, temp.end ());
	temp += "\"";
	in->append (new dString (temp));
      }
  _pclose (pipeIn);
  return in;
}

dObject *
dQuit (dList *args)
{
  string message;
  int exit_code = 0;
#ifdef DEBUG
  message = "Goodbye, and thanks for all the fish!";
#endif
  if (args != 0)
    {
      if (args->size == 1)
	if ((*args)[0]->type == 's')
	  message = (*args)[0]->toString ();
	else if ((*args)[0]->type == 'i')
	  exit_code = toInt ((dNumber*)(*args)[0]);
	else
	  return new dError ("accepts a string argument");
      else if (args->size == 2)
	{
	  if ((*args)[0]->type == 's')
	    message = (*args)[0]->toString ();
	  else
	    return new dError ("accepts a string argument");
	  if ((*args)[1]->type == 'i')
	    exit_code = toInt ((dNumber*)(*args)[1]);
	  else
	    return new dError ("accepts a string and integer argument");
	}
    }
  if (!message.empty ())
    {
      console->WriteLine (message);
      #ifdef ENABLE_DEBUGLOG
      debuglog->Write (debuglog->BUG_LEVEL_WARNING,
		       "Exited with message \"%s\" and code: %i",
		       message.c_str (), exit_code);
      debuglog->Save ();
      #endif
      message.clear ();
    }
#ifdef ENABLE_DEBUGLOG
  else
    debuglog->Write (debuglog->BUG_LEVEL_WARNING,
		     "Exited with code: %i",
		     exit_code);
#endif
  // Causes a segfault for some reason :S
  //killSystemEnvironment ();
  exit (exit_code);
  return T;
}



dObject *
dIsAtom (dList *args)
{
  if (args == 0)
    return new dError ("atom accepts a single object of any type");
  switch ((*args)[0]->type)
    {
    case 's':
    case 'S':
    case 'i':
    case 'd':
    case 'r':
      return T;
      break;
    }
  return nil;
}

dObject *
dSlice (dList *args)
{
  if (args == 0 || ((*args)[0]->type != 's'
		    && (*args)[0]->type != 'l' && (*args)[0]->type == 'v'))
    return new dError ("slice: argument 1 must be a list, or string");
  dObject *sliced = (*args)[0];
  int start = 0;
  int length = 0;
  if ((*args)[1] != nil && (*args)[1]->type == 'i')
    start = toInt ((dNumber*)(*args)[1]);
  else
    return new dError ("slice: argument 2 must be an integer");
  if ((*args)[2] != nil)
    {
      if ((*args)[2]->type == 'i')
	length = toInt ((dNumber*)(*args)[2]);
      else
	return new dError ("slice: argument 3 must be an integer");
    }
  else
    length = 1;
  // String slicing
  if (sliced->type == 's')
    {
      string sliced_string = ((dString*)sliced)->value;
      //printf ("start: %i\tlength: %i\t(*args)[2]: %i\n",
      //start, length, toInt ((dNumber*)(*args)[2]));
      sliced_string = sliced_string.substr (start, length);
      return new dString (sliced_string);
    }
  // List slicing
  else if (sliced->type == 'l')
    {
      dList *inList = (dList*)sliced;
      dList *sliced_list = new dList ();
      if (start < 0)
	start = length - (-1 * start);
      if (length < 0 && (*args)[2] != nil)
	length = inList->size + length - start;
      printf ("start: %i\tlength: %i\n", start, length);
      for (int i = start; (*inList)[i] != 0 && i < length+start; i++)
	sliced_list->append ((*inList)[i]);
      return sliced_list;
    }
  return new dError ("slice: argument 1 must be a list, or string");
}

dObject *
dLength (dList *args)
{
  if (args == 0)
    return new dError ("len: argument 1 must be a list, or string");
  if ((*args)[0]->type == 's')
    return new dNumber ((int)((dString*)(*args)[0])->value.length ());
  else if ((*args)[0]->type = 'l')
    return new dNumber (((dList*)(*args)[0])->size);
  else
    return new dError ("len: argument 1 must be a list, or string");
}


// Major user functions
dObject *
dDateTime (dList *args)
{
#ifdef TARGET_OS_WINDOWS || TARGET_OS_MACOSX
  return new dError ("Date-Time function doesn't work in Windows just yet :(");
#else
  // Thanks to O'Reilly's C++ Cookbook, recipe 5.2
  time_t now = time (NULL);
  tm t = *localtime (&now);
  stringstream out;
  const time_put<char>& dateWriter = use_facet<time_put<char> >(out.getloc ());
  string format = "";
  if (args == 0)
    format = "%A %B, %d %Y %I:%M%p";
  else if (args->size == 1 && (*args)[0]->type == 's')
    format = (*args)[0]->toString ();
  else
    return new dError ("requires a string or no argument at all");
  dateWriter.put (out, out, ' ', &t, format.c_str (),
		  format.c_str () + format.length ());
  return new dString (out.str ());
#endif
}

dObject *
dInput (dList *args)
{
  if (args != 0 && args->size == 1)
    console->Write (dProcessString ((*args)[0]->toString ()));
  char *input, buffer[256];
#if defined (TARGET_OS_WINDOWS) || !defined (READLINE)
  input = fgets (buffer, 256, stdin);
  input[strlen (input)-1] = '\0';
#else
  input = readline ("");
  if (*input)
    add_history (input);
#endif
  if (isDec (input))
    return new dNumber (strtod (input, (char**)NULL));
  else if (isInt (input))
    return new dNumber ((int)strtol (input, (char**)NULL, 10));
  // ToDo: Add Rational check
  return new dString (input);
}

dObject *
dPrint (dList *args)
{
  if (args == 0 || (*args)[0] == 0)
    return nil;
  return dPrintFormat (args, true);
}

dObject *
dFormat (dList *args)
{
  if (args == 0 || (*args)[0] == 0)
    return nil;
  return dPrintFormat (args, false);
}

dObject *
dPrintFormat (dList *args, bool p)
{
  if (args == 0)
    {
      if (p)
	cout << "";
      return new dString ("");
    }
  //string format; format.reserve (256);
  string text;
  for (int i = 0; i < args->size; i++)
    {
      if ((*args)[i]->type == 'e')
	return (*args)[i];
      else if ((*args)[i]->type != 'n')
	{
	  text += dProcessString ((*args)[i]->toString ());
	  if (p)
	    console->Write ((*args)[i]->toString ());
	}
    }
  //text = dProcessString (text);
  if (p) console->Write ("\n");
  return new dString (text);
}

dObject *
dAdd (dList *args)
{
  if (args == 0 || args->size < 1)
    return new dError ("+ requires at least 1 number argument");
  dNode *current = args->first;
  dObject *item = 0;
  dNumber *num = 0;
#ifdef BIGNUM
  mpf_class sum = 0;
  mpq_class rSum = mpq_class (0, 1);
#else
  double sum = 0.0;
  dRational rSum = dRational (0, 1);
#endif
  bool anyDecimals = false;
  bool anyRationals = false;
  while (current != 0)
    {
      item = current->car;
      //printf ("Item ***\n");
      //debug (item);
      if (item->type == 'd')
	{
	  sum += ((dNumber*)item)->Decimal ();
	  anyDecimals = true;
	}
      else if (item->type == 'r')
	{
	  if (anyDecimals)
	    sum += ((dNumber*)item)->Decimal ();
	  else
	    rSum = rSum + ((dNumber*)item)->Rational ();
	}
      else if (item->type == 'i')
	{
	  if (anyRationals)
#ifdef BIGNUM
	    rSum = rSum + mpq_class (((dNumber*)item)->Integer (), 1);
#else
	    rSum = rSum + dRational (((dNumber*)item)->Integer (), 1);
#endif
	  else
	    sum += ((dNumber*)item)->Integer ();
	}
      else
	return new dError ("+ only accepts decimals, integers and rationals");
      current = current->cdr;
    }
  if (anyDecimals)
#ifdef BIGNUM
    return new dNumber (mpf_class (sum));
#else
    return new dNumber (sum);
#endif
  else if (anyRationals)
    return new dNumber (rSum);
  return new dNumber (
#ifdef BIGNUM
		      mpz_class (sum)
#else
		      (int) sum
#endif
		      );
}

dObject *
dSubtract (dList *args)
{
  if (args == 0)
    return new dError ("- requires at least 1 number argument");
  dNode *current = args->first;
  dObject *item = 0;
  dNumber *num = 0;
#ifdef BIGNUM
  mpf_class diff = 0;
#else
  double diff = 0.0;
#endif
  bool anyDoubles = false;
  bool anyRationals = false;
  //cout << "in function subtract...\n";
  if (current == 0)
    return new dError ("Empty list");
  else
    {
      item = current->car;
      if (item->type == 'd' || item->type == 'i' || item->type == 'r')
	{
	  num = (dNumber*)item;
	  diff = num->Decimal ();
	  if (num->type == 'd')
	    anyDoubles = true;
	  else if (num->type == 'r')
	    anyRationals = true;

	}
      else
	return new dError ("- only accepts decimals, integers and rationals");
      current = current->cdr;
    }
  while (current != 0)
    {

      item = current->car;
      if (item->type == 'd' || item->type == 'i' || item->type == 'r')
	{
	  num = (dNumber*)item;
	  diff -= num->Decimal ();
	  if (num->type == 'd')
	    anyDoubles = true;
	  else if (num->type == 'r')
	    anyRationals = true;
	}
      current = current->cdr;
    }
  if (anyDoubles)
    return new dNumber (
#ifdef BIGNUM
			mpf_class (diff)
#else
			diff
#endif
			);
  else if (anyRationals)
      return new dNumber (
#ifdef BIGNUM
			  mpq_class (diff)
#else
			  dRational (diff)
#endif
			  );
  return new dNumber (
#ifdef BIGNUM
		      mpz_class (diff)
#else
		      (int) diff
#endif
		      );
}

dObject *
dMultiply (dList *args)
{
  if (args == 0)
    return new dError ("* requires at least 1 number argument");
  dNode *current = args->first;
  dObject *item = 0;
  dNumber *num = 0;
#ifdef BIGNUM
  mpf_class product = 1.0;
#else
  double product = 1.0;
#endif
  bool anyDoubles = false;
  bool anyRationals = false;
  //cout << "in function multiply...\n";
  if (current == 0)
    return new dError ("Empty list");
  while (current != 0)
    {
      item = current->car;
      if (item->type == 'd' || item->type == 'i' || item->type == 'r')
	{
	  num = (dNumber*)item;
	  product *= num->Decimal ();
	  if (num->type == 'd')
	    anyDoubles = true;
	  else if (num->type == 'r')
	    anyRationals = true;
	}
      else
	return new dError ("* only accepts decimals, integers and rationals");
      current = current->cdr;
    }
  if (anyDoubles)
    return new dNumber (
#ifdef BIGNUM
			mpf_class (product)
#else
			product
#endif
			);
  else if (anyRationals)
      return new dNumber (
#ifdef BIGNUM
			  mpq_class (product)
#else
			  dRational (product)
#endif
			  );
  return new dNumber (
#ifdef BIGNUM
		      mpz_class (product)
#else
		      (int) product
#endif
		      );
}

dObject *
dDivide (dList *args)
{
  if (args == 0 || args->size < 2
      || (*args)[0]->type != 'd' || (*args)[0]->type != 'i'
      || (*args)[0]->type != 'r')
    return new dError ("/ requires at least 2 number argument");
  dObject *item = 0;
  dNumber *num = 0;
#ifdef BIGNUM
  mpf_class quotient = 0;
#else
  double quotient = 0;
#endif
  bool anyDoubles = false;
  bool anyRationals = false;
  quotient = toInt ((dNumber*)(*args)[0]);
  for (int i = 1; i < args->size; i++)
    {
      item = (*args)[i];
      if (item->type == 'd' || item->type == 'i' || item->type == 'r')
	{
	  if (item->type == 'd' || item->type == 'r')
	    {
	      num = (dNumber*)item;
	      quotient /= num->Decimal ();
	      if (num->type == 'd')
		anyDoubles = true;
	    }
	  else if (item->type == 'i' && !anyDoubles)
	    {
	      num = (dNumber*)item;
#ifdef BIGNUM
	      quotient = mpz_class (quotient) / num->Integer ();
#else
	      quotient /= num->Integer ();
#endif
	    }
	}
      else
	return new dError ("/ only accepts decimals, integers and rationals");
    }
  if (anyDoubles)
    return new dNumber (
#ifdef BIGNUM
			mpf_class (quotient)
#else
			quotient
#endif
			);
#ifdef BIGNUM
  return new dNumber (mpq_class (quotient));
#else
  return new dNumber (dRational (quotient));
#endif
}

dObject *
dDiv (dList *args)
{
  if (args == 0)
    return new dError("div: requires 2 arguments");

  dNumber *a;
  if ((*args)[0]->type != 'i')
    return new dError ("div: argument 1 must be an integer");
  a = (dNumber*)(*args)[0];

  dNumber *b;
  if ((*args)[1]->type != 'i')
    return new dError ("div: argument 2 must be an integer");
  b = (dNumber*)(*args)[1];
#ifdef BIGNUM
  return new dNumber (mpz_class (a->Integer () % b->Integer ()));
#else
  return new dNumber (a->Integer () % b->Integer ());
#endif
}

dObject *
dMod (dList *args)
{
  if (args == 0)
    return new dError("mod: requires 2 arguments");

  dNumber *a;
  if ((*args)[0]->type != 'i')
    return new dError ("mod: argument 1 must be an integer");
  a = (dNumber*)(*args)[0];

  dNumber *b;
  if ((*args)[1]->type != 'i')
    return new dError ("mod: argument 2 must be an integer");
  b = (dNumber*)(*args)[1];
#ifdef BIGNUM
  return new dNumber (mpz_class (toInt (a) % toInt (b)));
#else
  return new dNumber (toInt (a) % toInt (b));
#endif
}
